﻿(*   Copyright 2011 Alexander Omelchuk
 *
 *   Licensed under the Apache License, Version 2.0 (the "License");
 *   you may not use this file except in compliance with the License.
 *   You may obtain a copy of the License at
 *
 *       http://www.apache.org/licenses/LICENSE-2.0
 *
 *   Unless required by applicable law or agreed to in writing, software
 *   distributed under the License is distributed on an "AS IS" BASIS,
 *   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 *   See the License for the specific language governing permissions and
 *   limitations under the License.
 *)

namespace Lisp
open System

[<AutoOpen>]
module Lst =
  let Nil = Id kwNil :> SExpr
  let T   = Id kwT   :> SExpr

  let (|Lst|Id|Val|) (expr:SExpr) =
    match expr with
    | :? Id as x -> Id x.Name
    | :? Cons as x -> Lst(x.Car,x.Cdr)
    | x -> Val x

  let(|Nil|NotNil|) = function
  | Id x when x = kwNil -> Nil
  | _ -> NotNil

  let (|Lst2|Not|) = function
  | Lst(car,Lst(cdar,cddr)) -> Lst2 (car, cdar, cddr)
  | _ -> Not

  let (|Lst3|Not|) = function
  | Lst(car,Lst(cdar,Lst(cddar,cdddr))) -> Lst3 (car, cdar, cddar, cdddr)
  | _ -> Not

  let setCar (cons:SExpr) value =
    match cons with
    | :? Cons as x -> x.Car <- value
    | _ -> failwith "cannot set car to not cons"

  let setCdr (cons:SExpr) value =
    match cons with
    | :? Cons as x -> x.Cdr <- value
    | _ -> failwith "cannot set cdr to not cons"

  let rec fold f state = function
  | Lst(x,xs) -> fold f (f state x) xs
  | _ -> state

  // returns state and remaining cdr
  let rec foldC f state = function
  | Lst(x,xs) -> foldC f (f state x) xs
  | x -> state, x

  let rec fold2a f state = function
  | Lst2(x1,x2,xs) -> fold2a f (f state x1 x2) xs
  | _ -> state

  let rec iter f = function
  | Lst(x,xs) -> f x; iter f xs
  | _     -> ()

  // it's like List.iter2 but handles lists of different sizes
  // returns what's left of lists
  let rec iter2 f = function
  | Lst(x,xs), Lst(y,ys) -> f x y; iter2 f (xs, ys)
  | x -> x
               
  let rec mapToCons cons f = function
  | Lst(x,xs) -> let cons2 = Cons(f x, Nil)
                 setCdr cons cons2
                 mapToCons cons2 f xs
  | _ -> ()

  let map f = function
  | Lst(x,Nil) -> Cons (f x, Nil) :> SExpr
  | Lst(x,xs) -> let cons = Cons (f x, Nil)
                 mapToCons cons f xs
                 cons :> SExpr
  | _ -> Nil

  let rec mapSeq f expr =
    seq { match expr with
          | Lst(car,cdr) -> yield f car
                            yield! mapSeq f cdr
          | _ -> () }

  let toSeq expr = mapSeq id expr
  let toList expr = mapSeq id expr |> Seq.toList

  let ofSeq (seq: #SExpr seq) =
    let result, last = ref Nil, ref Nil
    Seq.iteri (fun i x ->
      if i = 0 then result := Cons(x, Nil) :> SExpr
                    last := !result
               else let newLast = Cons(x,Nil)
                    setCdr !last newLast
                    last := newLast :> SExpr)
              seq
    !result

  ///<summary>Strongly typed version for reflector.</summary>
  let ofSExprSeq (seq: SExpr seq) = ofSeq seq